perm filename EXPRS.SAI[AL,HE] blob
sn#501007 filedate 1980-03-10 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00009 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 IFCR ¬DECLARATION(EXTENDED_COMPILATION) THENC
C00004 00003 ! new_var,new_lbl,asglbl
C00006 00004 ! dtype, vtcheck
C00008 00005 ! vnode managers: add_vnode, okvnget
C00011 00006 ! inval0, invalidate, eval, getvalue, arrayref, vchange, dchange, killvar
C00021 00007 ! expeqv
C00023 00008 ! invsimp
C00025 00009 ! evalexpr
C00034 ENDMK
C⊗;
IFCR ¬DECLARATION(EXTENDED_COMPILATION) THENC
ENTRY; COMMENT Requirements, initialization of constants;
BEGIN "EXPRS"
DEFINE EXPRS_TERNAL = "INTERNAL";
IFCR ¬ DECLARATION(CREFFING) THENC DEFINE CREFFING = "FALSE";ENDC
IFCR ¬ CREFFING THENC
REQUIRE "ALREQ.HDR[AL,HE]" SOURCE_FILE;
REQUIRE "GOBBLE.HDR[AL,HE]" SOURCE_FILE;
ENDC
REDEFINE $$PRGID "[]" = ["EXPRS"];
IFCR CREFFING THENC REQUIRE $$PRGID MESSAGE;ENDC
ENDC
INTERNAL INTEGER CURTIME; INITIALIZE (CURTIME←1);
! new_var,new_lbl,asglbl;
INTERNAL RPTR(VARIABLE) PROCEDURE NEW_VAR(STRING NAME; INTEGER DT; RBLK BID);
BEGIN
RVAR VAR;
VAR ← NEW_RECORD(VARIABLE);
VARIABLE:NAME[VAR] ← NAME;
VARIABLE:DATATYPE[VAR] ← DT;
VARIABLE:BLK[VAR] ← BID;
IF BID ≠ RNULL THEN
IF DT = EVENT_DTYPE THEN CONSON(VAR,BLOCK:EVTS[BID])
ELSE CONSON(VAR,BLOCK:VARS[BID]);
RETURN(VAR);
END;
INTERNAL RPTR(LBLVAR) PROCEDURE NEW_LBL(STRING NAME; INTEGER DT; RBLK BID);
BEGIN
RPTR(LBLVAR) L;
L ← NEW_RECORD(LBLVAR);
LBLVAR:DATATYPE[L] ← DT;
LBLVAR:BLK[L] ← BID;
LBLVAR:NAME[L] ← NAME;
RETURN(L);
END;
INTERNAL RANY PROCEDURE ASGLBL(RPTR(LBLVAR) L;RPTR(ANY_CLASS) SEM);
BEGIN
IF RECTYPE(SEM) = LOC(STMNT) THEN ! have the stmnt point to the label;
BEGIN
STMNT:STLAB[SEM] ← L;
IF RECTYPE(STMNT:SEMANTICS[SEM]) = LOC(CMON) THEN
SEM ← STMNT:SEMANTICS[SEM];
END;
IF RECTYPE(SEM) = LOC(CMON) THEN LBLVAR:DATATYPE[L] ← OMNLAB_DTYPE;
LBLVAR:SEMANTICS[L] ← SEM;
RETURN(SEM)
END;
! dtype, vtcheck;
INTERNAL INTEGER SIMPLE PROCEDURE DTYPE(INTEGER DT);
START_CODE
MOVE 0,DT; ! this is cretinous, but ...;
MOVEI 1,0;
CAIN 0,SVAL_DTYPE;
MOVEI 1,SVAL;
CAIN 0,V3ECT_DTYPE;
MOVEI 1,V3ECT;
CAIN 0,ROTN_DTYPE;
MOVEI 1,ROTN;
CAIN 0,TRANS_DTYPE;
MOVEI 1,TRANS;
CAIN 0,FRAME_DTYPE;
MOVEI 1,FRAME;
END;
INTERNAL RPTR(VALU$) PROCEDURE VTCHECK(RVAR VAR; RPTR(VALU$) VAL);
BEGIN
INTEGER DT,VART;
DT ← VARIABLE:DATATYPE[VAR];
VART ← RECTYPE(VAL);
IF VART ≠ DTYPE(DT) THEN
IF DT=FRAME_DTYPE ∧ VART=LOC(TRANS) THEN RETURN(NEW_FRAME(VAL))
ELSE USERERR(1,1,"TYPE MISMATCH IN VTCHECK");
RETURN(VAL)
END;
RPTR(VALU$) PROCEDURE TFCVT(RPTR(VALU$) V); ! Used by evalexpr & eval;
IF RECTYPE(V)=LOC(FRAME) THEN RETURN(FRAME:VAL[V])
ELSE RETURN(V);
! vnode managers: add_vnode, okvnget;
PROCEDURE ADD_VNODE(RPTR(VNODE) VN, VL);
BEGIN ! Add vnode VN to vnode list headed by VL;
RPTR(VNODE) VO;
WHILE VL≠RNULL ∧ VNODE:VAR[VL] < VNODE:VAR[VN] DO VL ← VNODE:NEXT[(VO←VL)];
VNODE:NEXT[VN] ← VL;
VNODE:NEXT[VO] ← VN ! Splice into list;
END;
RPTR(VNODE) PROCEDURE OKVNGET(RVAR VAR; RTHREAD WLD);
BEGIN
! returns a graph node for VAR which may be modified in
world WLD without causing strange side effects in other
worlds;
RPTR(VNODE) GN;
GN ← VARIABLE:PLNVAL[VAR];
IF GN = RNULL ∨ VNODE:THREAD[GN] ≠ WLD THEN
BEGIN ! Make up a new vnode for this thread;
GN ← NEW_RECORD(VNODE);
VNODE:VAR[GN] ← VAR; ! Add back pointers;
VNODE:THREAD[GN] ← WLD;
VNODE:OLDVAL[GN] ← VARIABLE:PLNVAL[VAR]; ! If any;
VNODE:INVMARK[GN] ← -1;
VARIABLE:PLNVAL[VAR] ← GN;
ADD_VNODE(GN,THREAD:VALS[WLD]); ! Link onto value thread;
END;
RETURN(GN);
END;
! inval0, invalidate, eval, getvalue, arrayref, vchange, dchange, killvar;
! These routines perform graph node operations in a named planning world.
Their individual actions are those specified in the AL report. ;
RECURSIVE PROCEDURE INVAL0(RVAR VAR; RTHREAD WLD; REFERENCE RCELL INVLSEEN);
BEGIN
! procedure used as working loop of invalidate:
(1) looks to see if it has already invalidated VAR by
checking whether id of VAR is in INVLSEEN.
(2) if plnval vnode is null or valid, then
gets a vnode for this world & sets INVMARK to -1.
(3) processes all dependent nodes.
;
INTEGER RT;
RPTR(VNODE) GN;
RPTR(CALC) C;
IF MEMQ(VAR,INVLSEEN) THEN RETURN;
CONSON(VAR,INVLSEEN);
GN ← OKVNGET(VAR,WLD); ! Get a vnode for this world;
VNODE:INVMARK[GN] ← -1; ! It's no longer valid;
C ← VARIABLE:CALCS[VAR];
WHILE C ≠ RNULL DO ! Invalidate everyone we're affixed to;
BEGIN
IF CALC:TYPE[C] ≠ 0 THEN ! Non-rigid + frame 1;
INVAL0(CALC:OTHER[C],WLD,INVLSEEN);
! ***** ????What happens to the bvar for non-rigid affixments here???? *****;
C ← CALC:NXTCALC[C]
END
END;
INTERNAL RPTR(VNODE) RECURSIVE PROCEDURE INVALIDATE(RVAR VAR; RTHREAD WLD);
BEGIN
RCELL INVLSEEN;
INVLSEEN ← RNULL;
INVAL0(VAR,WLD,INVLSEEN);
RETURN(VARIABLE:PLNVAL[VAR])
END;
RECURSIVE RPTR(VNODE) PROCEDURE EVAL (RVAR VAR; INTEGER T; RTHREAD WLD);
BEGIN
INTEGER I;
RPTR(VNODE) GN,OVN,BVN;
RPTR(CALC) C;
GN ← VARIABLE:PLNVAL[VAR];
! see if we already have a valid value, or have already looked for one;
IF GN ≠ RNULL ∧ (VNODE:INVMARK[GN]=0 ∨ VNODE:INVMARK[GN]=T) THEN RETURN(GN);
! nope - have to use a calc;
GN ← OKVNGET(VAR,WLD);
VNODE:INVMARK[GN] ← T;
FOR I ← 1 STEP 1 UNTIL 2 DO
BEGIN
C ← VARIABLE:CALCS[VAR];
WHILE C ≠ RNULL DO
BEGIN
IF CALC:TYPE[C] ≠ 2 THEN ! Non-rigid + frame 2;
BEGIN
IF I = 1 THEN
BEGIN ! First time see if someone's already valid;
OVN ← VARIABLE:PLNVAL[CALC:OTHER[C]];
BVN ← VARIABLE:PLNVAL[CALC:BVAR[C]];
END
ELSE
BEGIN ! Second time try to validate someone;
OVN ← EVAL(CALC:OTHER[C], T, WLD);
BVN ← EVAL(CALC:BVAR[C], T, WLD)
END;
IF OVN ≠ RNULL ∧ VNODE:INVMARK[OVN] = 0
∧ BVN ≠ RNULL ∧ VNODE:INVMARK[BVN] = 0 THEN ! Both are valid;
BEGIN
RPTR(TRANS,FRAME) T1,T2;
T1 ← TFCVT(VNODE:VAL[OVN]);
T2 ← TFCVT(VNODE:VAL[BVN]);
IF CALC:TYPE[C] LAND 2 THEN T2 ← TINVRT(T2); ! Frame 2;
VNODE:VAL[GN] ← NEW_FRAME(TTMUL(T1,T2));
VNODE:INVMARK[GN] ← 0;
RETURN(GN)
END
END;
C ← CALC:NXTCALC[C]
END
END;
RETURN(GN); ! we did the best we could;
END;
INTERNAL RPTR(VALU$) PROCEDURE GETVALUE (RVAR VAR;
RTHREAD WLD; BOOLEAN OK(FALSE));
BEGIN
RPTR(VNODE) GN;
GN ← VARIABLE:PLNVAL[VAR];
IF GN = RNULL ∨ VNODE:INVMARK[GN] ≠ 0 THEN
GN ← EVAL(VAR,CURTIME←CURTIME+1,WLD);
IF GN = RNULL ∨ VNODE:INVMARK[GN] ≠ 0 THEN
BEGIN
IF ¬OK THEN PRINT(CRLF & "WARNING: ", VARIABLE:NAME[VAR],
" has no plan value - will use zero" & CRLF);
CASE VARIABLE:DATATYPE[VAR] OF
BEGIN ! really return something so we;
[SVAL_DTYPE] RETURN(FALSEV); ! don't generate more error;
[V3ECT_DTYPE] RETURN(NILVECT); ! messages than need be;
[ROTN_DTYPE] RETURN(NILROTN);
[TRANS_DTYPE] RETURN(NILTRANS);
[FRAME_DTYPE] RETURN(NILDEPROACH);
ELSE RETURN(RNULL)
END
END;
RETURN(VNODE:VAL[GN]);
END;
INTERNAL RECURSIVE RVAR PROCEDURE ARRAYREF(REXPR E; RTHREAD WLD);
BEGIN
INTEGER I,J,N;
RCELL SS;
RPTR(ARRAYDEF) H;
SS ← EXPRN:ARGS[E];
H ← LLOP(SS);
I ← N ← 1;
WHILE SS ≠ RNULL ∧ I ≤ ARRAYDEF:NUMDIMS[H] DO
BEGIN
J ← SVAL:VAL[EVALEXPR(LLOP(SS),WLD)]; ! get subscript's value;
IF J > ARRAYDEF:BDVALS[H][I,1] THEN
BEGIN
USERERR(1,1,"ARRAYREF: SUBSCRIPT TOO LARGE");
J ← ARRAYDEF:BDVALS[H][I,1]
END;
IF (J ← J - ARRAYDEF:BDVALS[H][I,0]) < 0 THEN
BEGIN
USERERR(1,1,"ARRAYREF: SUBSCRIPT TOO SMALL");
J ← 0
END;
N ← N + J * ARRAYDEF:BDVALS[H][I,2];
I ← I + 1
END;
RETURN(ARRAYDEF:VARS[H][N])
END;
INTERNAL RECURSIVE PROCEDURE VCHANGE(RPTR(VARIABLE,EXPRN) VAR;
RPTR(VALU$) NEWV; RTHREAD WLD);
BEGIN
RPTR(VNODE) GN;
RPTR(CALC) C;
IF (RECTYPE(VAR)=LOC(EXPRN)) ∧ (EXPRN:OP[VAR]=AREF_OP) THEN
VAR ← ARRAYREF(VAR,WLD);
GN ← INVALIDATE(VAR,WLD);
IF NEWV ≠ RNULL THEN
BEGIN
VNODE:VAL[GN] ← VTCHECK(VAR,NEWV);
VNODE:INVMARK[GN] ← 0;
C ← VARIABLE:CALCS[VAR];
WHILE C ≠ RNULL DO
BEGIN
IF CALC:TYPE[C] = 0 THEN ! Non-rigid + frame 1;
VCHANGE(CALC:BVAR[C],TTMUL(
TINVRT(GETVALUE(CALC:OTHER[C],WLD,TRUE)), NEWV), WLD);
C ← CALC:NXTCALC[C]
END
END
ELSE VNODE:INVMARK[GN] ← -1;
END;
INTERNAL PROCEDURE DCHANGE(RPTR(VARIABLE,EXPRN) VAR;
RPTR(VALU$) NEWV; RTHREAD WLD);
BEGIN
RPTR(VNODE) GN;
IF (RECTYPE(VAR)=LOC(EXPRN)) ∧ (EXPRN:OP[VAR]=AREF_OP) THEN
VAR ← ARRAYREF(VAR,WLD);
GN ← VARIABLE:DEPR[VAR];
IF GN = RNULL ∨ VNODE:THREAD[GN] ≠ WLD THEN
BEGIN ! Make up a new vnode for this thread;
GN ← NEW_RECORD(VNODE);
VNODE:VAR[GN] ← VAR; ! Add back pointers;
VNODE:THREAD[GN] ← WLD;
VNODE:OLDVAL[GN] ← VARIABLE:DEPR[VAR]; ! If any;
VARIABLE:DEPR[VAR] ← GN;
ADD_VNODE(GN,THREAD:DEPRS[WLD]); ! Link onto value thread;
END;
VNODE:VAL[GN] ← NEWV
END;
INTERNAL PROCEDURE KILLVAR(RTHREAD WLD; RVAR VAR);
BEGIN
RPTR(CALC) C;
C ← VARIABLE:CALCS[VAR];
WHILE C ≠ RNULL DO ! Unfix us from rest of world;
BEGIN
DO_UNFIX(WLD,VAR,CALC:OTHER[C]); ! Unfix will validate them if possible;
C ← VARIABLE:CALCS[VAR]
END
END;
! expeqv;
! Symbolic comparison of expressions. not very bright about
commutative laws, etc. Returns TRUE if it thinks that E1 ≡ E2;
INTERNAL RECURSIVE BOOLEAN PROCEDURE EXPEQV(RPTR(EXPRN,VALU$,VARIABLE) E1,E2);
BEGIN
INTEGER T1,T2;
IF E1 = E2 THEN RETURN(TRUE);
T1←RECTYPE(E1);T2←RECTYPE(E2);
IF T1≠ T2 THEN RETURN(FALSE);
IF T1= LOC(VARIABLE) THEN RETURN(FALSE); ! had to be eq;
IF T1= LOC(SVAL) THEN RETURN(SVAL:VAL[E1]=SVAL:VAL[E2]);
IF T1= LOC(V3ECT) THEN RETURN(V3CMP(E1,E2)=0);
IF T1= LOC(ROTN) THEN RETURN(ROTCMP(E1,E2)=0);
IF T1= LOC(TRANS) THEN RETURN(TRANSCMP(E1,E2)=0);
IF T1= LOC(FRAME) THEN RETURN(TRANSCMP(FRAME:VAL[E1],FRAME:VAL[E2])=0);
IF T1= LOC(EXPRN) THEN
BEGIN
RCELL C1,C2;
IF EXPRN:OP[E1]≠EXPRN:OP[E2] THEN RETURN(FALSE);
IF EXPRN:DATATYPE[E1]≠EXPRN:DATATYPE[E2] THEN RETURN(FALSE);
C1←EXPRN:ARGS[E1];C2←EXPRN:ARGS[E2];
WHILE C1≠NULL_RECORD ∧ C2≠NULL_RECORD DO
BEGIN
IF ¬EXPEQV(CELL:CAR[C1],CELL:CAR[C2]) THEN RETURN(FALSE);
C1←CELL:CDR[C1];
C2←CELL:CDR[C2];
END;
RETURN(C1=C2);
END;
USERERR(1,1,"EXPEQV: CONFUSION");
RETURN(FALSE);
END;
! invsimp;
INTERNAL REXPR RECPROC INVSIMP(REXPR E);
BEGIN
REXPR EE;RCELL C,CC;
BOOLEAN FLAG;
IF RECTYPE(E)≠LOC(EXPRN) THEN RETURN(E);
FLAG←FALSE;
C←EXPRN:ARGS[E];
IF EXPRN:OP[E]=TINVRT_OP THEN
BEGIN
EE←INVSIMP(CELL:CAR[C]);
IF RECTYPE(AE)=LOC(EXPRN) THEN
BEGIN
IF EXPRN:OP[EE]=TINVRT_OP THEN RETURN(CELL:CAR[EXPRN:ARGS[EE]])
END;
IF EE≠CELL:CAR[C] THEN
BEGIN
FLAG←TRUE;
CC←CONS(EE,NULL_RECORD)
END;
END
ELSE WHILE C≠NULL_RECORD DO
BEGIN
EE←INVSIMP(LLOP(C));
CC←APPEND(CC,COH
&Q∃
Y≥+1_1%
∨%λR$v~∀∪→→β∂?Q%+
v4∀∪ ≥⊂v~∀@@A∪ ↓
→β∞↓)⊃ ≤↓% )+I≤Q≥ \1 1!I≤Q 1A%≤u ¬)β)3A 7 :1 1!%8u∨!7∃:Yπε$R~∀∩@@A 1'
A%∃)+%≤!
R~∀@@A 9λv~∀_BAKYCYKqAd@v~(~∃∪≥Q %≥β0A%!)HQ-β→THRA%∃π!%∨ A -β1 1!$!%!)$! 1!%8Y-β%%β¬→
1-β→*⊂RA
wI)⊃% ¬λA/→⊂Rv~∀@@A¬∃∂∪≤~(~∀@@@BAKYCYkCQKfAi!JAaY¬]]S]≤AmCYUJA←L↓Kqae∃ggS←8[YSW∀AiQS9NA
A%\~∀@@@@A]←eYH↓/→λ@_AeKiUe]fA∧AmCYUJ@QJ9N\XAYKGi←HXAgm¬XXAiIC]fRv~∀~(@@@AI!)$Q
→_R↓εv~∀@@A%A)$Q-¬→*HR↓,bY,HY,fv4∀@@@↓∪≥) ≥ $A Q3 v~(~∀@@A∪ A∀{≥+→01% π=%λA)! ≤A%∃)+%≤!
Rv~(~∀@@A )3@A>A%∃π)3!∀Q
Rv4∀@@@↓∪ A Q3 @z↓→∨εQYβ%∪β →
RAQ⊃ ≤AI )+%8Q∂ )Yβ→+
!
Y/→⊂RR~∀@@A 1'
A∪_A )3@{→∨ε!'-β_$@>A Q3 {→=εQ
%­
R@|A )3@{→∨ε!)%β≥LR@>~(∪ )3@{→∨ε!,g πPR@>A∃)3 {1∨εQ%=)≤RAQ⊃ ≤~(∩@@@↓% )+I≤Q
R4∀@@@↓ →'
↓∪ A Q3 {→=εQ
∨Iπ
RAQ⊃ ≤~(∪% )U%≤Q≥∃.1'-¬_P`R$∩BA≥<ASIK∧AoQCPAiQJ↓CGik¬XAmC1kJAo%YXAE∀v~∀@@A →M
A∪ ↓ )3 m→∨εQ∃1!%≤$A)⊃ 8~∀∪¬∃∂∪≤~(∪+' I %$PDXbXE∃-β→ a!$tA βλAβI∂+≠ 9(DRv4∀∪% Q+%≤Q9+→_1I π∨%⊂Rv~∀% ≥λv4∀@@@↓π? 1A%≤uβI∂'7 tv~∀@@A∪ ↓ 1!%8u∨!7∃:{β%∃ 1∨ >A 1A%≤u∨A7 :{
β→_1= @>A∃1!%≤i∨!7 t{#+ I21∨ ~∀∪)! ≤Aπ⎇%≥+→0v~∀@@A∪ ↓ε7≥+1_1%
∨%λAQ⊃ ≤AXc?)
-(Q Yβ→ 1A$Q→→= QεR1/→λR$v~∀@@A∪ ↓ε7≥+1_1%
∨%λAQ⊃ ≤AXe?)
-(Q Yβ→ 1A$Q→→= QεR1/→λR$v~∀@@A∪ ↓ε7≥+1_1%
∨%λAQ⊃ ≤AXg?)
-(Q Yβ→ 1A$Q→→= QεR1/→λR$v~∀~(@@@A
β'
A∃1!%≤i∨!7 tA∨ ~(∩@@@↓¬ ∂∪8~∀~∃m≥≡1∨A:@@@@@@@↓% )+I≤Q,b$v~∀~)7'πβ1%λ1∨A:~∃7E+ %2a∨!:@@@@AI )+%8Q
β→M ,Rv4∀~∃7Mβ¬&1=!:@@@@@AI )+%8Q≥ .a'-β_!β¬&AM-β_uYβ→7,E:RRv4∀~∃7M≥ ∞1=!:@@@@@AI )+%8Q≥ .a'-β_ ['-β0u-β→m,c:R$v~∀~)7'β ⊂1∨!:@@@@A% )U%≤Q≥∃.1'-¬_Q'-¬_u-β17,c:-'-β_i-β→7Xe:RRl~∀~∃m''+∧a∨!:@@@@@↓% )+I≤Q≥ \1'-β0Q'-β0u-β→m,c:[M-β_uYβ→7,I:RRv4∀~∃7M≠+_1=!:@@@@@AI )+%8Q≥ .a'-β_!'-β_i-β→7Xc:U'Yβ_u-¬→7,etRRv~(~∃7'⊃∪,1∨A:@@@@@A%∃)+%≤!≥ .1M-β_QM-β_uYβ→7,E:←'-¬_u-β17,e:$Rv~∀4∃7' a 1∨!t@@@@@A% Q+%≤Q9 .1'Yβ_Q'Yβ_u-¬→7,cu='-β0u-β→m,e:R$v~∀~)7≠β0a∨!:@@@@@A% )U%≤Q≥∃.1'-¬_Q'-¬_u-β17,c:↓≠β0AM-β_uYβ→7,I:RRv4∀~∃75∪≤1∨A:@@@@@@AI )+%8Q≥ .a'-β_!'-β_i-β→7Xc:A≠%≤A'-¬_u-β17,e:$Rv~∀4∃7∪≥P1∨!:@@@@@A% Q+%≤Q9 .1'Yβ_Q'Yβ_u-¬→7,ctA ∪,bRRv4∀~∃7⊃∪,1∨A:@@@@@@AI )+%8Q≥ .a'-β_!'-β_i-β→7Xc:A %,A'-¬_u-β17,e:$Rv~∀4∃7≠∨⊂1∨!:@@@@@A% Q+%≤Q9 .1'Yβ_Q'Yβ_u-¬→7,ctA≠∨λ↓'-β_i-β→7Xe:RRl~∀~∃m'→(1=!:@@@@@@↓% )+I≤Q≥ \1'-β0Q'-β0u-β→m,c:yM-β_uYβ→7,I:RRv4∀~∃7M "1∨A:@@@@@@AI )+%8Q≥ .a'-β_!'-β_i-β→7Xc:{'Yβ_u-¬→7,etRRv~(~∃7'1
1∨!t@@@@@@A%∃)+%≤!≥ .1M-β_QM-β_uYβ→7,E:9'-¬_u-β17,e:$Rv~∀4∃7'∂∀1∨!:@@@@@A% Q+%≤Q9 .1'Yβ_Q'Yβ_u-¬→7,ct;'-β0u-β→m,e:R$v~∀~)7'≥
a∨!:@@@@@A% )U%≤Q≥∃.1'-¬_Q'-¬_u-β17,c:m'-β_i-β→7Xe:RRl~∀~∃m'∂(1=!:@@@@@@↓% )+I≤Q≥ \1'-β0Q'-β0u-β→m,c:⎇M-β_uYβ→7,I:RRv4∀~∃7¬≥λ1∨A:@@@@@@AI )+%8Q≥ .a'-β_!'-β_i-β→7Xc: 'Yβ_u-¬→7,etRRv~(~∃7∨H1∨!:@@@@@@A%∃)+%≤!≥ .1M-β_QM-β_uYβ→7,E:?'-¬_u-β17,e:$Rv~∀4∃7≥∨P1∨!:@@@@@A% Q+%≤Q9 .1'Yβ_P M-β_uYβ→7,E:RRv4∀~∃7a∨$1∨A:@@@@@@AI )+%8Q≥ .a'-β_!'-β_i-β→7Xc:-'Yβ_u-¬→7,etRRv~(~∃7 E,1∨!t@@@@@@A%∃)+%≤!≥ .1M-β_QM-β_uYβ→7,E:='-¬_u-β17,e:$Rv~∀4∃7-≠¬∂≤1∨A:@@@@A% Q+%≤Q9 .1'Yβ_Q'E%(Q,M ∨(QXbY,b$RRRv4∀~∃7Y ∨(1=!:@@@@@AI )+%8Q≥ .a'-β_!,g ∨PQ,bYXdRRRl~∀~∃m-π%∨M&1∨!t@@@@↓% )+I≤Q,g
%∨'&!,bY,HRRv~(~∃7%5β∂≤1=!:@@@@A%∃)+%≤!%≠β∂8Q,bR$v~∀~)7β1∪L1∨!:@@@@A% )U%≤Qβa∪&Q,DRRv~(~∃7'Y≠+_1=!:@@@@A%∃)+%≤!'-≠+0Q'-β0u-β→m,c:YXdRRv4∀~∃7Y' ∪,a∨!:@@@@AI )+%8Q'-≠U_Pb\@←'-β0u-β→m,e:YXbRRv4∀~∃7Y≠β↔
a∨!:@@@@AI )+%8Q≥ .a,g πPQ'-β0u-β→m,c:YM-β_uYβ→7,I:Y'-¬_u-β17,g:$Rv~∀4∃7-β⊃λ1∨!t@@@@@A% Q+%≤QXgβ λ!,bY,HRRv~(~∃7-M+∧1∨A:@@@@@A%∃)+%≤!,g'+λQ,bYXdRRv4∀~∃7I-≠+_a∨!:@@@@AI )+%8Q%-≠U_Q,b1,dRRl~∀~∃m+- πP1∨!:@@@@↓% )+I≤Q+-∃π(Q,DRRv~(~∃7!=&1∨!t@@@@@@A%∃)+%≤!!∨&QXbRRv4∀~∃7=%∪ ≥P1∨!:@@@AI )+%8Q∨%∪∃≥(Q,DRRv~(~∃7βa.1%∨Q≤1∨!t@@A%∃)+%≤!β1.1I∨)≤QXbY'-¬_u-β17,e:$Rv~∀4∃7%%5+_1∨A:@@@@A% Q+%≤QI%≠+_!,bY,HRRv~(~∃7)5β↔
1=!:@@@@A%∃)+%≤!≥ .1Q%β≥&!π⊃↔%∃εQ,b1→∨εQI∨)≤R$Yπ⊃↔I εQ,HY→∨ε!,g πPRR@R$v~∀~)7π∨≥M)$1∨A:@@@A% )U%≤Qπ=≥')$!,bY,HY,fR$v~∀~)7)-β⊃λ1∨!t@@@@A% )U%≤Q≥∃.1)%¬≥&Q)Iβ≥&uI7,c:1,gβ ⊂Q)%β9&u!7Xc:Y,HRRRv4∀~∃7Q-'+∧a∨!:@@@@AI )+%8Q≥ .a)%β≥LQ)%β9&u%7Xc:Y,M'+∧QQ%β≥&i!7,ctY,dR$Rv~∀4∃7)-5+_1∨A:@@@@A% Q+%≤QQ-≠+_!,bY,HRRv~(~∃7
Q∨ 1∨A:@@@@@A%∃)+%≤!))≠+0Q)∪≥Y%(Qπ!↔% εV1,LOC(TRANS))),CHKREC(V2,LOC(TRANS))) );
[TTMUL_OP] RETURN(TTMUL(V1,V2));
[TINVRT_OP] RETURN(TINVRT(V1));
[DEPR_OP] BEGIN
IF V2 ≠ RNULL THEN RETURN(V2);
V2 ← DEPR(CELL:CAR[EXPRN:ARGS[E]]); ! in wldmod not arith;
CONSON(V2,EXPRN:ARGS[E]);
RETURN(EVALEXPR(V2,WLD));
END;
[FMAKE_OP] RETURN(NEW_FRAME(
NEW_TRANS(CHKREC(V1,LOC(ROTN)),CHKREC(V2,LOC(V3ECT)) ) ));
[TFMAKE_OP] RETURN(NEW_FRAME(V1));
[SSBRTN_OP] CASE (ETYP←SVAL:VAL[V1]) OF
BEGIN
[SQRT_OP] RETURN(NEW_SVAL(SQRT(SVAL:VAL[V2])));
[SIN_OP] RETURN(NEW_SVAL(SIND(SVAL:VAL[V2])));
[COS_OP] RETURN(NEW_SVAL(COSD(SVAL:VAL[V2])));
[TAN_OP] RETURN(NEW_SVAL(SIND(SVAL:VAL[V2])/COSD(SVAL:VAL[V2])));
[ASIN_OP] RETURN(NEW_SVAL(ASIN(SVAL:VAL[V2]) * DEG));
[ACOS_OP] RETURN(NEW_SVAL(ACOS(SVAL:VAL[V2]) * DEG));
[ATAN2_OP] RETURN(NEW_SVAL(ATAN2(SVAL:VAL[V2],SVAL:VAL[V3])*DEG));
[LOG_OP] RETURN(NEW_SVAL(LOG(SVAL:VAL[V2])));
[EXP_OP] RETURN(NEW_SVAL(EXP(SVAL:VAL[V2])));
[TIME_OP] RETURN(NEW_SVAL(SVAL:VAL[V2]+1.0))
END;
[AREF_OP] RETURN(GETVALUE(ARRAYREF(E,WLD),WLD));
[CALL_OP] CASE PROCDEF:DATATYPE[CELL:CAR[EXPRN:ARGS[E]]] OF
BEGIN
[SVAL_DTYPE] RETURN(FALSEV);
[V3ECT_DTYPE] RETURN(NILVECT);
[ROTN_DTYPE] RETURN(NILROTN);
[TRANS_DTYPE] RETURN(NILTRANS);
[FRAME_DTYPE] RETURN(NILDEPROACH);
ELSE RETURN(FALSEV)
END;
[LAST_OP] END;
USERERR(1,1,"EVALEXPR: INVALID OP");
RETURN(NULL_RECORD);
END;
END $$PRGID;